%% The MIT License
%% 
%% Paralog is licensed under the MIT License.
%% 
%% Copyright (c) 2008 Robert Ahrens <mindangels@yahoo.com>
%% 
%% Permission is hereby granted, free of charge, to any person obtaining a copy
%% of this software and associated documentation files (the "Software"), to deal
%% in the Software without restriction, including without limitation the rights
%% to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
%% copies of the Software, and to permit persons to whom the Software is
%% furnished to do so, subject to the following conditions:
%% 
%% The above copyright notice and this permission notice shall be included in
%% all copies or substantial portions of the Software.
%% 
%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
%% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
%% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
%% AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
%% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
%% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
%% THE SOFTWARE.
%% 

%% @author Robert Ahrens <mindangels@yahoo.com>
-module(pl_run).
-export([
         %% unify/3, 
         %% external_call/3,
         unify/4,
         %% run_query/4,
         test_db/0,
         test_db2/0,
         test_db3/0
        ]).

-compile(export_all).

-include("pl_syntax.hrl").


%%%%  ACTION ITEMS AS OF 2008.09.01 ...
%%
%%  (in no particular order of precedence)
%%
%%   2) Introduce "facts" as an optimization on rules.
%%   3) Introduce arity as an optimization on facts and rules.
%%   4) Do away with Value as a return for try_expr -- WRONG!!! 
%%      What we need to do is just to scope "value" to inside
%%      try_expr, not bubble it up to the user.
%%   6) Introduce the idea of an iterator, such that
%%      we can either iterate over the entire search space or
%%      just until we have a successful binding set to return.
%%   7) Refactor the bindings list to store {?v(K), V} instead
%%      of {K, V}, so that we can unify against it directly.
%%      Double-check!!!  Is this really a good idea?
%%   8) Explore using contains_vars to optimize storage of
%%      values at binding time.
%%  10) Figure out whether competing processes have partitioned
%%      databases and/or how to act across parallel procs.
%%  11) Wire in a module to provide "operators" ie. language
%%      level constructs, inside try_expr.
%%  14) Add asserta and assertz.  Go through the runtime and 
%%      interpreter code and ensure that the database gets passed
%%      around appropriately so that changes get preserverd.  (OR,
%%      commit to abandoning the notion of a pass-by-val db
%%      and instead rely on its process nature.
%%  15) Add spy and the other operators.
%%  18) Rewrite large chunks of this module to be tail recursive,
%%      maintaining stacks and queues rather than depending on
%%      the Erlang runtime to do so.  Test this new version against
%%      the old to see which one provides greater performance
%%      and scalability.
%%  21) Prefix rules and facts with their module-name so as to
%%      provide rudimentary namespacing.  Provide a global namespace
%%      too ...?
%%  22) Understand and then introduce the "cut" operator.
%%  24) Fix pl_interpreter:call/2 so it does what we think it should.
%%  26) Verify that reify_args is doing what it should do.
%%
%%
%%  IN PROGRESS ...
%%
%%
%% 
%%  THIS SPACE FOR LISTING WORK WHICH HAS BEEN DONE.
%%
%%   1) Rewrite the spec for rules to be clearer.
%%   5) Parameterize the DB into a behaviour.  
%%  16) Replace the naive primitives such as {rule, Foo, Bar}
%%      with more obscure terms like {'__PARALOG_RULE__', Foo, Bar}
%%      so as to reduce the namespace collision likelihood.
%%  17) Place these rules in a pl_syntax.hrl and include them
%%      in this module and the compiler.  Maybe wrap them in a 
%%      pl_syntax.erl module which provides them as functions
%%      as well.
%%  12) Expect to load the database from a runtime level
%%      list of active modules.
%%  23) Set up the interpreter as a p-mod so we can have it store
%%      load settings, the db etc.
%%   9) Write DB modules which use gen_server + ETS to do
%%      the work.  (The gen_server is implemented, still need
%%      to use ets rather than a server_side list in memory.)
%%  25) Make a demo pure erlang module using pls to represent
%%      what the compile target should look like.
%%  13) Start work on the compiler: write a yecc file.
%%  19) Use the Erlang tokenizer to explore the tokens generated
%%      from Prolog syntax.  Make sure these match our yeccfile.
%%  20) Write the compiler module to provide appropriate 
%%      transformations.
%%


call_rule(RuleName, ArgSchema, Bindings, DB) ->
    case reify_args(ArgSchema, Bindings, DB) of
        {ok, InitialArgs, Bind2, DB2} ->
            ClauseList = DB:lookup(RuleName, length(ArgSchema)),
            try_clauses(ClauseList, InitialArgs, Bind2, DB2);
        fail ->
            fail
    end.


%% Iterate over Schema and bind in each member.  Either return
%% {ok, InitialArgs, FinalBindings, FinalDB} if successful
%% %% or else fail.
reify_args(Schema, Bindings, DB) ->
    reify_args(Schema, Bindings, DB, []).


reify_args([Spec|Rest], Bindings, DB, ArgsAcc) ->
    case try_expr(Spec, Bindings, DB) of
        {ok, Val, Bind2, DB2} ->
            reify_args(Rest, Bind2, DB2, [Val|ArgsAcc]);
        fail ->
            fail
    end;
reify_args([], Bindings, DB, ArgsAcc) ->
    {ok, lists:reverse(ArgsAcc), Bindings, DB}.


%% NOTE: This approach isn't tail recursive and therefore isn't
%% scaleable as a language implementation.  But I am trying to
%% be correct first and worry about that later.
try_clauses([], _ArgVals, _OuterBindings, _DB) ->
    fail;
%% try_clauses([{fact, ArgSpec}|OFacts], ArgVals, OuterBindings, DB) ->
%%     case unify(ArgSpec, ArgVals, [], DB) of
%%         fail ->
%%             try_clauses(OFacts, ArgVals, OuterBindings, DB);
%%         Bindings ->
%%             {ok, true, reconcile_bindings(ArgSpec, ArgVals, Bindings, OuterBindings, DB), DB}
%%     end;
try_clauses([?rule(_RName, ArgSpec, ExprList)|ORules], ArgVals, OuterBindings, DB) ->
    %%?NOTE: Deliberately start with no "extra" bindings 
    %% other than what's passed in as ArgVals.
    case unify(ArgSpec, ArgVals, [], DB) of
        fail ->
            try_clauses(ORules, ArgVals, OuterBindings, DB);
        InitialBindings ->
            case try_expressions(ExprList, InitialBindings, DB) of
                {ok, Value, FinalBindings, DB2} ->
                    case return_bindings(ArgVals, ArgSpec, FinalBindings, OuterBindings, DB) of
                        {ok, DoneBinding} ->
                            {ok, Value, DoneBinding, DB2};
                        fail ->
                            try_clauses(ORules, ArgVals, OuterBindings, DB)
                    end;
                fail ->
                    try_clauses(ORules, ArgVals, OuterBindings, DB)
            end
    end.


%% 3rd (hah!!!) attempt ...
return_bindings(ArgVals, _ArgSpec, FinalBindings, OuterBindings, _DB) ->
    VarsSought = contains_vars(ArgVals),
    case get_all_bindings(VarsSought, FinalBindings, []) of
        fail ->
            fail;
        {ok, Bindings} ->
            {ok, Bindings ++ OuterBindings}
    end.


get_all_bindings([H|T], Bindings, Acc) ->
    case get_binding(H, Bindings) of
        none ->
            fail;
        BVal = {H, _} ->
            get_all_bindings(T, Bindings, [BVal|Acc])
    end;
get_all_bindings([], _, Acc) ->
    {ok, Acc}.


contains_vars(?v(X)) ->
    [X];
contains_vars(P) when ?is_primitive(P) ->
    [];
contains_vars([H|T]) ->
    case contains_vars(H) of
        [] -> contains_vars(T);
        SomeVars -> SomeVars ++ contains_vars(T)
    end;
contains_vars([]) ->
    [];
contains_vars(Tup) when is_tuple(Tup) ->
    contains_vars(tuple_to_list(Tup)).


try_expressions([], Bindings, DB) ->
    {ok, null, Bindings, DB};
try_expressions([Expr|Rest], Bindings, DB) ->
    case try_expr(Expr, Bindings, DB) of
        {ok, Value, Bind2, DB2} ->
            case Rest of
                [] -> {ok, Value, Bind2, DB2};
                _ -> try_expressions(Rest, Bind2, DB2)
            end;
        fail ->
            fail
    end.


%% @spec try_expr(Expr, Bindings, DB) -> {ok, Value, Bind2, DB2} | fail
%% @todo Why the hell are we returning a Value?  It's not Prolog and
%% it just complicates things.  Get rid of it!!!
try_expr(?call(RuleName, ArgSchema), Bindings, DB) ->
    call_rule(RuleName, ArgSchema, Bindings, DB);

try_expr(?erlang(M, F, AList), Bindings, DB) ->
    case reify_args(AList, Bindings, DB) of
        {ok, ExprArgs, Bind2, DB2} ->
            {ok, apply(M, F, ExprArgs), Bind2, DB2};
        fail ->
            fail
    end;

try_expr(?unify(SubEx1, SubEx2), Bindings, DB) ->
    case try_expr(SubEx1, Bindings, DB) of
        {ok, Val1, Bind2, DB2} ->
            case try_expr(SubEx2, Bind2, DB2) of
                {ok, Val2, Bind3, DB3} ->
                    unify(Val1, Val2, Bind3, DB3);
                fail ->
                    fail
            end;
        fail ->
            fail
    end;

try_expr(?v(X), Bindings, DB) ->
    case get_binding(X, Bindings) of
        none ->
            {ok, ?v(X), Bindings, DB};
        {X, BoundVal} ->
            {ok, BoundVal, Bindings, DB}
    end;

try_expr(P, Bindings, DB) when ?is_primitive(P) ->
    {ok, P, Bindings, DB};

try_expr([H|T], Bindings, DB) ->
    case try_expr(H, Bindings, DB) of
        {ok, VH, Bind2, DB2} ->
            case try_expr(T, Bind2, DB2) of
                {ok, VT, Bind3, DB3} ->
                    {ok, [VH|VT], Bind3, DB3};
                fail ->
                    fail
            end;
        fail ->
            fail
    end;

try_expr([], Bindings, DB) ->
    {ok, [], Bindings, DB};

try_expr(Tup, Bindings, DB) when is_tuple(Tup) ->
    case try_expr(tuple_to_list(Tup), Bindings, DB) of
        {ok, ListOVals, Bind2, DB2} ->
            {ok, list_to_tuple(ListOVals), Bind2, DB2};
        fail ->
            fail
    end.


get_binding(VarName, Bindings) ->
    proplists:lookup(VarName, Bindings).


add_binding(Var, Val, Bindings) ->
    [{Var, Val} | Bindings].


occurs_in(VarName, ?v(VarName)) ->
    true;
occurs_in(_, ?v(_)) ->
    false;
occurs_in(_, P) when ?is_primitive(P) ->
    false;
occurs_in(VarName, Tuple) when is_tuple(Tuple) ->
    occurs_in(VarName, tuple_to_list(Tuple));
occurs_in(VarName, [H|T]) ->
    case occurs_in(VarName, H) of
        true -> true;
        false -> occurs_in(VarName, T)
    end;
occurs_in(_, []) ->
    false.


try_binding(?v(X), ?v(X), Bindings, _DB) -> 
    Bindings;
try_binding(?v(X), Pattern, Bindings, DB) ->
  case get_binding(X, Bindings) of
      none ->
          case occurs_in(X, Pattern) of
              true ->
                  fail;
              false ->
                  add_binding(X, Pattern, Bindings)
          end;
      {X, BoundVal} ->
          unify(BoundVal, Pattern, Bindings, DB)
  end.


%% @spec unify(pterm(), pterm(), bindings(), database()) -> {ok, bindings(), database()} | fail
unify(_, _, fail, _) ->   %% Is this case necessary?  Pattern from L&S....
    fail;
unify(?v(X), Pattern, Bindings, DB) ->
    try_binding(?v(X), Pattern, Bindings, DB);
unify(Pattern, ?v(Y), Bindings, DB) ->
    try_binding(?v(Y), Pattern, Bindings, DB);
unify(X, X, Bindings, _DB) when ?is_primitive(X) ->
    Bindings;
unify(X, _, _Bindings, _DB) when ?is_primitive(X) ->
    fail;
unify(_, Y, _Bindings, _DB) when ?is_primitive(Y) ->
    fail;
unify(T1, T2, Bindings, DB) 
  when is_tuple(T1) andalso is_tuple(T2) ->
    if
        size(T1) == size(T2) ->
            unify(tuple_to_list(T1), tuple_to_list(T2), Bindings, DB);
        true ->
            fail
    end;
unify([H1|T1], [H2|T2], Bindings, DB) ->
    case unify(H1, H2, Bindings, DB) of
        fail ->
            fail;
        Bind2 ->
            unify(T1, T2, Bind2, DB)
    end;
unify([], [], Bindings, _DB) ->
    Bindings;
unify(_, _, _, _) ->
    fail.


test_db() ->
    %% literal syntax
    [{{paralog, rule}, liked_by, 
      [{{paralog, var}, 'M'}, {{paralog, var}, 'N'}],
      [{{paralog, call}, likes, [{{paralog, var}, 'N'}, {{paralog, var}, 'M'}]}]},
     {{paralog, rule}, likes, [zoa, sarah], []},
     {{paralog, rule}, likes, [robert, sarah], []},
     {{paralog, rule}, likes, [zoa, milk], []},
     {{paralog, rule}, likes, [robert, cheese], []},
     {{paralog, rule}, likes, [robert, zoa], []},
     {{paralog, rule}, likes, [sarah, zoa], []}
    ].


test_db2() ->
    %% with helper macros
    [?rule(liked_by, [?v('M'), ?v('N')],
           [?call(likes, [?v('N'), ?v('M')])]),
     ?fact(likes, [zoa, sarah]),
     ?fact(likes, [robert, sarah]),
     ?fact(likes, [zoa, milk]),
     ?fact(likes, [robert, cheese]),
     ?fact(likes, [robert, zoa]),
     ?fact(likes, [sarah, zoa])
    ].


test_db3() ->
    %% with the pls ("paralog syntax") module
    [pls:rule(liked_by, [pls:v('M'), pls:v('N')],
              [pls:call(likes, [pls:v('N'), pls:v('M')])]),
     pls:fact(likes, [zoa, sarah]),
     pls:fact(likes, [robert, sarah]),
     pls:fact(likes, [zoa, milk]),
     pls:fact(likes, [robert, cheese]),
     pls:fact(likes, [robert, zoa]),
     pls:fact(likes, [sarah, zoa])
    ].


get_test_db() ->
    get_test_db(list_db).


get_test_db(Mod) ->
    Mod:new(test_db()).
